home *** CD-ROM | disk | FTP | other *** search
/ System Booster / System Booster.iso / Archives / ARexxTools / fpl70.lha / src / script.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-04-08  |  63.4 KB  |  2,311 lines
  1. /******************************************************************************
  2.  *              FREXX PROGRAMMING LANGUAGE                  *
  3.  ******************************************************************************
  4.  
  5.  script.c
  6.  
  7.  The main routine of the language. Handles all keywords, {'s and }'s.
  8.  
  9.  *****************************************************************************/
  10.  
  11. /************************************************************************
  12.  *                                                                      *
  13.  * fpl.library - A shared library interpreting script langauge.         *
  14.  * Copyright (C) 1992-1994 FrexxWare                                    *
  15.  * Author: Daniel Stenberg                                              *
  16.  *                                                                      *
  17.  * This program is free software; you may redistribute for non          *
  18.  * commercial purposes only. Commercial programs must have a written    *
  19.  * permission from the author to use FPL. FPL is *NOT* public domain!   *
  20.  * Any provided source code is only for reference and for assurance     *
  21.  * that users should be able to compile FPL on any operating system     *
  22.  * he/she wants to use it in!                                           *
  23.  *                                                                      *
  24.  * You may not change, resource, patch files or in any way reverse      *
  25.  * engineer anything in the FPL package.                                *
  26.  *                                                                      *
  27.  * This program is distributed in the hope that it will be useful,      *
  28.  * but WITHOUT ANY WARRANTY; without even the implied warranty of       *
  29.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                 *
  30.  *                                                                      *
  31.  * Daniel Stenberg                                                      *
  32.  * Ankdammsgatan 36, 4tr                                                *
  33.  * S-171 43 Solna                                                       *
  34.  * Sweden                                                               *
  35.  *                                                                      *
  36.  * FidoNet 2:201/328    email:dast@sth.frontec.se                       *
  37.  *                                                                      *
  38.  ************************************************************************/
  39.  
  40. #ifdef AMIGA
  41. #include <exec/types.h>
  42. #include <proto/exec.h>
  43. #include <libraries/dos.h>
  44. #include <proto/dos.h>
  45.  
  46. #include <exec/libraries.h>
  47. #include <dos.h>
  48.  
  49. #elif defined(UNIX)
  50. #include <sys/types.h>
  51. #endif
  52.  
  53. #include <stdio.h>
  54. #include <string.h>
  55. #include "script.h"
  56.  
  57. #ifdef DEBUG
  58. long mem=0;
  59. long maxmem=0;
  60. #endif
  61.  
  62. static ReturnCode INLINE AddProgram(struct Data *, struct Program **,
  63.                     char *, long, char *);
  64. static char REGARGS CheckIt(struct Data *, struct Expr *, short, ReturnCode *);
  65. static ReturnCode INLINE Declare(struct Expr *, struct Data *,
  66.                  struct Identifier *, long);
  67. static ReturnCode INLINE Eatcomment(struct Data *);
  68. static ReturnCode Go(struct Data *, struct Expr *val);
  69. static ReturnCode REGARGS Loop(struct Data *, struct Condition *, short, char *);
  70. static ReturnCode INLINE Resize(struct Data *, struct Expr *, char);
  71. static ReturnCode REGARGS SkipStatement(struct Data *);
  72. static ReturnCode REGARGS StoreGlobals(struct Data *, char type);
  73. static ReturnCode REGARGS Run(struct Data *, char *, char *, long, unsigned long *);
  74. static ReturnCode INLINE Switch(struct Data *, struct Expr *, short,
  75.                                 struct Condition *);
  76. /*
  77.  * Global static string arrays for everywhere access:
  78.  */
  79.  
  80. const char type[256] = {    /* Character type codes    Hex        */
  81.   END,   000,     000,    000,   000,   000,   000,   000, /* 00        */
  82.   000,   SPA,     SPA,    000,   000,   SPA,   000,   000, /* 08        */
  83.   000,   000,     000,    000,   000,   000,   000,   000, /* 10        */
  84.   000,   000,     000,    000,   000,   000,   000,   000, /* 18        */
  85.   SPA,   000,    000,    000,   000,   000,   000,   000, /* 20    !"#$%&' */
  86.   000,   000,    000,   000,   000,   000,   000,   000, /* 28 ()*+,-./ */
  87.   DIG|HEX, DIG|HEX, DIG|HEX, DIG|HEX,             /* 30 0123 */
  88.   DIG|HEX, DIG|HEX, DIG|HEX, DIG|HEX,             /* 34 4567 */
  89.   DIG,   DIG,    000,    000,   000,   000,   000,   000, /* 38 89:;<=>? */
  90.   000,   LET,     LET,    LET,   LET,   LET,   LET,   LET, /* 40 @ABCDEFG */
  91.   LET,   LET,     LET,    LET,   LET,   LET,   LET,   LET, /* 48 HIJKLMNO */
  92.   LET,   LET,     LET,    LET,   LET,   LET,   LET,   LET, /* 50 PQRSTUVW */
  93.   LET,   LET,     LET,    000,   000,   000,   000,   LET, /* 58 XYZ[\]^_ */
  94.   000,      LET|HEX, LET|HEX, LET|HEX,             /* 60 `abc */
  95.   LET|HEX,  LET|HEX, LET|HEX, LET,             /* 64 defg */
  96.   LET,   LET,     LET,    LET,   LET,   LET,   LET,   LET, /* 68 hijklmno */
  97.   LET,   LET,     LET,    LET,   LET,   LET,   LET,   LET, /* 70 pqrstuvw */
  98.   LET,   LET,     LET,    000,   000,   000,   000,   000, /* 78 xyz{|}~    */
  99.   000,   000,     000,    000,   000,   000,   000,   000, /*   80 .. FF    */
  100.   000,   000,     000,    000,   000,   000,   000,   000, /*   80 .. FF    */
  101.   000,   000,     000,    000,   000,   000,   000,   000, /*   80 .. FF    */
  102.   000,   000,     000,    000,   000,   000,   000,   000, /*   80 .. FF    */
  103.   000,   000,     000,    000,   000,   000,   000,   000, /*   80 .. FF    */
  104.   000,   000,     000,    000,   000,   000,   000,   000, /*   80 .. FF    */
  105.   000,   000,     000,    000,   000,   000,   000,   000, /*   80 .. FF    */
  106.   000,   000,     000,    000,   000,   000,   000,   000, /*   80 .. FF    */
  107. };
  108.  
  109.  
  110. /***************************************************************************
  111.  *
  112.  * fplExecuteFile()
  113.  *
  114.  * Executes the specified file as an FPL program. 
  115.  *
  116.  ******/
  117.  
  118. ReturnCode PREFIX fplExecuteFile(AREG(0) struct Data *scr,
  119.                  AREG(1) char *filename,
  120.                  AREG(2) unsigned long *tags)
  121. {
  122.   return(Run(scr, filename, NULL, 1, tags));
  123. }
  124.  
  125. /**********************************************************************
  126.  *
  127.  * fplExecuteScript()
  128.  *
  129.  * Frontend to Run().
  130.  *
  131.  * The error code is returned to daddy...
  132.  *
  133.  ******/
  134.  
  135. ReturnCode PREFIX fplExecuteScript(AREG(0) struct Data *scr, /* nice struct */
  136.                    AREG(1) char **program, /* program array */
  137.                    DREG(1) long lines,     /* number of lines */
  138.                    AREG(2) unsigned long *tags)
  139. {
  140.   return(Run(scr, NULL, *program, lines, tags));
  141. }
  142.  
  143.  
  144. /**************************************************************************
  145.  *
  146.  * ReadFile()
  147.  *
  148.  *   Reads the specified file into memory, stores the pointer to the memory
  149.  * area in the pointer `program' points to, and the size of the memory area
  150.  * in the integer `size' points to. I decided to use a different way on Amiga
  151.  * to increase performance a lot.
  152.  *
  153.  *   This function first checks the size of the file it's about to fetch
  154.  * and then reads the entire file at once in one continuos memory area.
  155.  *
  156.  *   Returns the proper return code. If anything goes wrong, there won't be
  157.  * *ANY* program to look at (the pointer will be NULL, but the size will most
  158.  * probably still be correct which means a non-zero value). If this function
  159.  * fails it takes care of freeing the program memory by itself. You only have
  160.  * to free that memory if this functions reports success.
  161.  *
  162.  ********/
  163.  
  164. ReturnCode
  165. ReadFile(void *fpl,
  166.          char *filename,
  167.          struct Program *prog)
  168. {
  169.   struct Data *scr=(struct Data *)fpl;
  170. #ifdef AMIGA  /* Amiga version. */
  171.   struct FileInfoBlock fileinfo;
  172.   struct FileLock *lock;
  173.   struct FileHandle *fileread;
  174.  
  175.   struct MyLibrary *lib = (struct MyLibrary *)getreg(REG_A6);
  176.   struct Library *DOSBase = lib->ml_DosBase;
  177. #elif defined(UNIX)
  178.   FILE *stream;
  179. #endif
  180.   ReturnCode ret=FPL_OK;
  181. #ifdef AMIGA
  182.   
  183.   /* Lock on source file to get file length! */
  184.   if (lock=(struct FileLock *)Lock((UBYTE *)filename, ACCESS_READ)) {
  185.     if (Examine((BPTR)lock, &fileinfo))
  186.       prog->size=fileinfo.fib_Size+1; /* Add one for a terminating zero! */
  187.     else
  188.       ret=FPLERR_OPEN_ERROR;    /* something went wrong */
  189.     if(!(scr->flags&FPLDATA_LOCKUSED)) {
  190.       UnLock((BPTR)lock);    /* release the lock of the file */
  191.       prog->lock=NULL;        /* no lock */
  192.     } else
  193.       prog->lock=(void *)lock;    /* store lock! */
  194.   } else
  195.     ret=FPLERR_OPEN_ERROR;        /* we couldn't lock on the file */
  196. #elif defined(UNIX)
  197.   if (!(stream = fopen(filename, "r")))
  198.     ret=FPLERR_OPEN_ERROR;
  199.   else {
  200.     if(fseek(stream, 0, 2)) {
  201.       fclose(stream);
  202.       ret=FPLERR_OPEN_ERROR;
  203.     } else {
  204.       prog->size=ftell(stream)+1;
  205.       fseek(stream, 0, 0);
  206.     }
  207.   }
  208. #endif
  209.   if(ret)
  210.     return(ret);
  211.   
  212.   /* Open file for reading. */
  213. #ifdef AMIGA
  214.   /* We could use OpenFromLock() here, but it's a V36+ function! */
  215.   fileread=(struct FileHandle *)Open((UBYTE *)filename, MODE_OLDFILE);
  216. #elif defined(UNIX)
  217.   /* file is already opened! */
  218. #endif
  219.   prog->program=(char *)MALLOC(prog->size); /* Allocate memory for program. */
  220.   if(!prog->program) /* if we didn't get the requested memory: */
  221.     ret=FPLERR_OUT_OF_MEMORY;
  222. #ifdef AMIGA
  223.   else if(Read((BPTR)fileread, prog->program, (LONG)prog->size)<0) /* get entire file */
  224. #elif defined(UNIX)
  225.   else if(!fread(prog->program, 1, prog->size, stream))
  226. #endif
  227.     /* if we couldn't Read() the file: */
  228.     ret=FPLERR_OPEN_ERROR;
  229.   else
  230.     (prog->program)[prog->size-1]='\0'; /* add the terminating zero byte. */
  231. #ifdef AMIGA
  232.   Close((BPTR)fileread); /* close file */
  233. #elif defined(UNIX)
  234.   fclose(stream); /* close the stream */
  235. #endif
  236.   /* only if error and we could allocate the proper memory */
  237.   if(ret && prog->program) {
  238.     FREE(prog->program); /* free the, for the program allocated, memory */
  239.   }
  240.   return(ret); /* get back to parent */
  241. }
  242.  
  243. /**********************************************************************
  244.  *
  245.  * AddProgram();
  246.  *
  247.  * Adds a program to FPL's internal lists of program files.
  248.  *
  249.  ****/
  250.  
  251. static ReturnCode INLINE AddProgram(struct Data *scr,
  252.                     struct Program **get,
  253.                     char *program,
  254.                     long lines,
  255.                     char *name)
  256. {
  257.   struct Program *next, *prog=NULL;
  258.   ReturnCode ret;
  259.   if(name) {
  260.     /*
  261.      * Name was given. Search through the internals to see if
  262.      * we have this file cached already!
  263.      */
  264.     prog=scr->programs;
  265.     while(prog) {
  266.       if(!strcmp(prog->name, name))
  267.     break;
  268.       prog=prog->next;
  269.     }
  270.   }
  271.   if(!prog) {
  272.     GETMEMA(prog, sizeof(struct Program));
  273.     memset(prog, 0, sizeof(struct Program));
  274. #ifdef DEBUG
  275.     CheckMem(scr, prog);
  276. #endif
  277.     next=scr->programs;
  278.     prog->next=next;
  279.     prog->program=program;
  280.     prog->lines=lines;
  281.     prog->startprg=1;
  282.     prog->virprg=1;
  283.     if(name) {
  284.       STRDUPA(prog->name, name);
  285.     }
  286.     scr->programs=prog;
  287.   } else {
  288.     /*
  289.      * The program already exists.
  290.      */
  291.     CALL(LeaveProgram(scr, scr->prog));
  292.     CALL(GetProgram(scr, prog));
  293.   }
  294.   scr->prog=prog;
  295.   *get=prog;
  296.   return(FPL_OK);
  297. }
  298.  
  299. /**********************************************************************
  300.  *
  301.  * DelProgram()
  302.  *
  303.  * Deletes a specifed program from memory. If NULL is specified where
  304.  * the program struct is supposed, all programs are removed! (Amiga
  305.  * version *have* to do that to UnLock() all files that might be locked
  306.  * when using the FPLTAG_LOCKUSED!
  307.  *
  308.  *******/
  309.  
  310. ReturnCode DelProgram(struct Data *scr,
  311.                      struct Program *del)
  312. {
  313.   struct Program *prog=scr->programs, *prev=NULL;
  314.   while(prog) {
  315.     if(!del || prog==del) {
  316.       if(prev)
  317.     prev->next=prog->next;
  318.       else
  319.     scr->programs=prog->next;
  320.       if(scr->prog==del)
  321.     scr->prog=scr->prog->next;
  322. #ifdef AMIGA
  323.       if(prog->lock)
  324.     UnLock((BPTR)prog->lock); /* unlock the program if it was locked before! */
  325. #endif
  326.       prev=prog->next;
  327.       if(prog->name)
  328.     FREEA(prog->name);
  329.       FREEA(prog);
  330.       if(!del) {
  331.     prog=prev;
  332.     prev=NULL;
  333.       } else {
  334.     if(del)
  335.       break;
  336.       }
  337.     } else {
  338.       prev=prog;
  339.       prog=prog->next;
  340.     }
  341.   }
  342.   return(FPL_OK);
  343. }
  344.  
  345. /**********************************************************************
  346.  *
  347.  * Run()
  348.  *
  349.  *****/
  350.  
  351. static ReturnCode REGARGS
  352. Run(struct Data *scr,
  353.     char *filename,
  354.     char *program,
  355.     long lines,
  356.     unsigned long *tags)
  357. {
  358.   ReturnCode ret, end;
  359.   struct Expr *val;
  360.   unsigned long *tag=tags;
  361.   char storeglobals;    /* DEFAULT: fplInit() value! */
  362.   struct Program *thisprog, *prog;
  363.   struct Store *store;
  364.   struct Local *glob;
  365.  
  366. #ifdef DEBUG
  367.   long memory=mem;
  368. #endif
  369.  
  370.   if(!scr)
  371.     /* misbehaviour */
  372.     return(FPLERR_ILLEGAL_ANCHOR);
  373.  
  374.   if(scr->runs) {
  375.     /* is this a nested call? */
  376.     LeaveProgram(scr, scr->prog);
  377.     GETMEM(store, sizeof(struct Store));
  378.     memcpy(store, &scr->text, sizeof(struct Store));
  379.   } else
  380.     scr->msg = NULL; /* We start with an empty message queue! */
  381.  
  382.   CALL(AddProgram(scr, &prog, program, lines, filename));
  383.  
  384.   if(!prog->program && filename) {
  385.     /*
  386.      * It didn't already exist.
  387.      */
  388.     CALL(ReadFile(scr, filename, prog)); /* get file */
  389.     prog->flags|=PR_FILENAMEFLUSH;
  390.   } else if(!filename)
  391.     prog->flags=PR_USERSUPPLIED;
  392.   
  393.   CALL(GetProgram(scr, prog)); /* lock it for our use! */
  394.   
  395.   thisprog=scr->prog;
  396.   if(scr->flags&FPLDATA_CACHEALLFILES) {
  397.     thisprog->flags|=PR_CACHEFILE;
  398.     if(scr->flags&FPLDATA_CACHEEXPORTS)
  399.       thisprog->flags|=PR_CACHEEXPORTS;
  400.   } else
  401.     thisprog->flags&=~PR_CACHEFILE;
  402.  
  403.   thisprog->openings++;
  404.  
  405.   scr->prg=thisprog->startprg;     /* starting line number */
  406.   scr->text=(&thisprog->program)[thisprog->startprg-1]+
  407.     thisprog->startcol; /* execute point */
  408.  
  409.   scr->ret=FPL_OK;        /* return code reset */
  410.   scr->virprg=1;        /* starting at virtual line 1 */
  411.   scr->level=0;            /* level counter */
  412.   scr->varlevel=0;        /* variable level */
  413.   scr->strret=FALSE;        /* we don't want no string back! */
  414.   scr->interpret=NULL;        /* no interpret tag as default */
  415.   scr->locals=NULL;        /* local symbol list */
  416.   scr->globals=NULL;        /* global symbol list */
  417.   scr->FPLret=0;        /* initialize return code value */
  418.   scr->string_return=NULL;    /* no string returns allowed */
  419. #ifdef COMPILE_AVAIL
  420.   scr->compiling=0;        /* no compiling */
  421. #endif
  422.  
  423.   while(tag && *tag) {
  424.     switch(*tag++) {
  425. #ifdef COMPILE_AVAIL
  426.     case FPLTAG_COMPILE: /* future implementation */
  427.       scr->compiling = (char)*tag;
  428.       break;
  429. #endif
  430.     case FPLTAG_STRING_RETURN:
  431.       scr->string_return = (char **)*tag;
  432.       scr->strret=TRUE; /* enable return string */
  433.       break;
  434.  
  435.     case FPLTAG_INTERPRET:
  436.       scr->interpret=(char *)*tag;
  437.       break;
  438.  
  439.     case FPLTAG_STARTPOINT:
  440.       scr->text=(char *)*tag;
  441.       break;
  442.     case FPLTAG_STARTLINE:
  443.       scr->prg=(long)*tag;
  444.       break;
  445.     case FPLTAG_USERDATA:
  446.       scr->userdata=(void *)*tag;
  447.       break;
  448.     case FPLTAG_CACHEFILE:
  449.       if(*tag) {
  450.     thisprog->flags|=PR_CACHEFILE;
  451.         if(*tag=FPLCACHE_EXPORTS)
  452.           thisprog->flags|=PR_CACHEEXPORTS;
  453.       } else
  454.     thisprog->flags&=~PR_CACHEFILE;
  455.       break;
  456.     case FPLTAG_PROGNAME:
  457.       prog=scr->programs;
  458.       while(prog) {
  459.     if(!strcmp(prog->name, (char *)*tag))
  460.       break;
  461.     prog=prog->next;
  462.       }
  463.       if(!prog) {
  464.     /*
  465.      * The program was not found, then set/rename the
  466.      * current program to this name!
  467.      */
  468.     if(thisprog->name) {
  469.       FREEA(thisprog->name);
  470.     }
  471.     STRDUPA(thisprog->name, *tag);
  472.       } else {
  473.     /*
  474.      * We found another progam with that name. Execute that
  475.      * instead of this!
  476.      */
  477.     DelProgram(scr, thisprog);
  478.     thisprog=prog;
  479.       }
  480.       break;
  481.     case FPLTAG_FILENAMEGET:
  482.       if(*tag)
  483.     thisprog->flags|=PR_FILENAMEFLUSH;
  484.       else
  485.     thisprog->flags&=~PR_FILENAMEFLUSH;
  486.       break;
  487.     }
  488.     tag++;
  489.   }
  490.  
  491.   if(!thisprog->name || scr->compiling) {
  492.     /* If no name has been given, do not store any global symbols from it! */
  493.     STRDUPA(thisprog->name, FPLTEXT_UNKNOWN_PROGRAM);
  494.     storeglobals=FALSE;
  495.     thisprog->flags&=~(PR_CACHEFILE|PR_CACHEEXPORTS);
  496.   } else
  497.     storeglobals = thisprog->flags&(PR_CACHEFILE|PR_CACHEEXPORTS);
  498.  
  499.   scr->virfile=thisprog->name; /* starting with this file */
  500.  
  501.   GETMEM(val, sizeof(struct Expr));
  502.   end=Go(scr, val);
  503.   if(end<=FPL_EXIT_OK &&
  504.      scr->string_return &&
  505.      (val->flags&(FPL_STRING|FPL_RETURN)) == (FPL_STRING|FPL_RETURN)) {
  506.     /*
  507.      * No error and
  508.      * we accept string returns and
  509.      * we have a returned string to deal with and
  510.      * there was a final "return" or "exit" keyword.
  511.      */
  512.  
  513.     /* assign the pointer */
  514.     if(val->val.str) {
  515.       *scr->string_return = val->val.str->string;
  516.  
  517.       /* make it a "static" allocation */
  518.       SwapMem(scr, val->val.str, MALLOC_STATIC);
  519.     }
  520.     else
  521.       *scr->string_return = NULL;
  522.  
  523.   }
  524.   FREE(val);
  525.  
  526.   if(end>FPL_EXIT_OK) {
  527.     struct fplArgument pass={
  528.       NULL, FPL_GENERAL_ERROR, NULL, 0};
  529.     void *array[1];
  530.     pass.key=(void *)scr;
  531.     array[0] = (void *)end;
  532.     pass.argv= array;
  533.  
  534.     /* new argv assigning for OS/2 compliance! */
  535.     InterfaceCall(scr, &pass, scr->function);
  536.   }
  537.   
  538.   thisprog->column=scr->text-(&thisprog->program)[scr->prg-1]+1;
  539.   scr->virfile=NULL; /* most likely to not point to anything decent
  540.             anyway! */
  541.  
  542.   /*
  543.    * Go through the ENTIRE locals list and delete all. Otherwise they will
  544.    * ruin the symbol table.
  545.    */
  546.  
  547.   while(scr->locals)
  548.     DelLocalVar(scr, &scr->locals);
  549.  
  550.   thisprog->openings--;
  551.   CALL(LeaveProgram(scr, thisprog));
  552.  
  553.   /*
  554.    * If the option to cache only programs exporting symbols is turned on,
  555.    * then we must check if any of the globals are exported before caching!
  556.    */
  557.  
  558.   if(end<=FPL_EXIT_OK && (storeglobals & PR_CACHEEXPORTS)) {
  559.     glob = scr->globals;
  560.  
  561.     while(glob) {
  562.       /* Traverse all global symbols */
  563.  
  564.       if(glob->ident->flags&FPL_EXPORT_SYMBOL)
  565.         /* if we found an exported symbol, get out of loop */
  566.         break;
  567.  
  568.       glob=glob->next; /* goto next global */
  569.     }
  570.  
  571.     if(!glob)
  572.       /* no exported symbols were found! */
  573.       storeglobals = FALSE; /* do not cache this file! */
  574.   }
  575.  
  576.   if(end<=FPL_EXIT_OK && storeglobals) {
  577.     /* is it changed and we should store the info and not compiling */
  578.  
  579.     if(!(thisprog->flags&PR_GLOBALSTORED)) {
  580.  
  581.       if(scr->globals) {
  582.  
  583.     /* Store all global symbols!!! */
  584.     CALL(StoreGlobals(scr, MALLOC_STATIC));
  585.       
  586.         if(thisprog->flags&PR_CACHEFILE && !(thisprog->flags&PR_USERSUPPLIED))
  587.       SwapMem(scr, thisprog->program, MALLOC_STATIC);
  588.         /* else
  589.        The memory is allocated by the user or not to be cached! */
  590.         thisprog->flags|=PR_GLOBALSTORED;
  591.       } else
  592.         DelProgram(scr, thisprog); /* this also removes the Lock() */
  593.     }
  594.   } else {
  595.     /*
  596.      * We must delete the global symbol lists
  597.      * properly and not just free the memory. Otherwise we might free memory
  598.      * used in the middle of the list we intend to save for next run!
  599.      */
  600.     if(!thisprog->openings) {
  601.       /* If not in use */
  602.       if(scr->globals)
  603.     /* There is some global symbols to delete! */
  604.     DelLocalVar(scr, &scr->globals);
  605.  
  606.       /* Delete this program from memory! */
  607.       DelProgram(scr, thisprog); /* this also removes the Lock() */
  608.     }
  609.   }
  610.  
  611.   tag=tags;
  612.   while(tag && *tag) {
  613.     switch(*tag++) {
  614.     case FPLTAG_FILEGLOBALS:
  615.       /* case FPLTAG_ISCACHED: */
  616.       *(long *)*tag=(long)scr->globals;
  617.       break;
  618.     }
  619.     tag++;
  620.   }
  621.  
  622.   if(!--scr->runs) { /* not running any more! */
  623.     if(end>FPL_EXIT_OK) {
  624.       FREEALL(); /* frees all ALLOC_DYNAMIC */
  625.     }
  626.   } else {
  627.     memcpy(&scr->text, store, sizeof(struct Store));
  628.     GetProgram(scr, scr->prog);
  629.     FREE(store);
  630.   }
  631.  
  632.   return(end==FPL_EXIT_OK?FPL_OK:end);
  633. }
  634.  
  635. /**********************************************************************
  636.  *
  637.  * Go();
  638.  *
  639.  * This is an own function to make the stack usage in this particular
  640.  * function very small. Then we don't have to copy more than 10-20 bytes
  641.  * of the old stack when swapping to the new in the amiga version of the
  642.  * library!
  643.  *
  644.  ******/
  645.  
  646. static ReturnCode Go(struct Data *scr, struct Expr *val)
  647. {
  648.   ReturnCode ret;
  649. #if defined(AMIGA) && defined(SHARED)
  650.   /* The function call below is a assembler routine that allocates a new
  651.      stack to use in the library! */
  652.   if(!scr->runs++) {
  653.     ret=InitStack(scr, val,
  654.           SCR_BRACE| /* to make it loop and enable declarations */
  655.           SCR_FUNCTION| /* return on return() */
  656.           SCR_GLOBAL, /* global symbol declarations enabled */
  657.           NULL);
  658.     EndStack(scr, scr->stack_max);
  659.   } else {
  660.     ret=Script(scr, val,
  661.            SCR_BRACE| /* to make it loop and enable declarations */
  662.            SCR_FUNCTION| /* return on return() */
  663.            SCR_GLOBAL, /* global symbol declarations enabled */
  664.            NULL);
  665.   }
  666. #else /* Not Amiga, Not shared! */
  667.   scr->runs++;
  668.   ret=Script(scr, val,
  669.          SCR_BRACE|    /* to make it loop and enable declarations */
  670.          SCR_FUNCTION| /* return on return() */
  671.          SCR_GLOBAL, /* global symbol declarations enabled */
  672.          NULL);
  673. #endif
  674.   return(ret);
  675. }
  676.  
  677.  
  678. static ReturnCode REGARGS
  679. StoreGlobals(struct Data *scr,
  680.              char type)
  681. {
  682.   struct Local *local, *prev=NULL;
  683.   struct Identifier *ident;
  684.   struct fplVariable *var;
  685.   
  686.   if(scr->prog->running>1)
  687.     /*
  688.      * It's enough if we commit this only on the ground level exit!
  689.      */
  690.     return(FPL_OK);
  691.  
  692.   local=scr->globals;
  693.   while(local) {
  694.     ident=local->ident;
  695.     if(ident->flags&FPL_VARIABLE) {
  696.       SwapMem(scr, local, type);        /* preserve the chain! */
  697.       SwapMem(scr, ident, type);        /* structure */
  698.       SwapMem(scr, ident->name, type);    /* name */
  699.       var=&ident->data.variable;
  700.       
  701.       SwapMem(scr, var->var.val32, type); /* variable area */
  702.  
  703.       if(!var->num && ident->flags&FPL_STRING_VARIABLE && var->var.str)
  704.     /* no array but string variable */
  705.     SwapMem(scr, var->var.str, type);    /* string */
  706.       else if(var->num) {
  707.     /* array */
  708.     SwapMem(scr, var->dims, type); /* dim info */
  709.     if(ident->flags&FPL_STRING_VARIABLE) {
  710.       int i;
  711.       for(i=0; i<var->size; i++) {
  712.         /* Take one pointer at a time */
  713.         if(var->var.str[i])
  714.           /* if the value is non-zero, it contains the allocated length
  715.          of the corresponding char pointer in the ->array->vars
  716.          array! */
  717.           SwapMem(scr, var->var.str[i], type);
  718.           }
  719.       SwapMem(scr, var->var.str, type);
  720.     }
  721.       }
  722.     } else if(ident->flags&FPL_FUNCTION) {
  723.       SwapMem(scr, local, type);        /* preserve the chain! */
  724.       SwapMem(scr, ident, type);        /* structure */
  725.       SwapMem(scr, ident->name, type);    /* name */
  726.       SwapMem(scr, ident->data.inside.format, type);    /* parameter string */
  727.     }
  728.     prev=local;
  729.     local=local->next;
  730.   }
  731.   if(prev) {
  732.     prev->next=scr->usersym; /* link in front of our previous list! */
  733.     scr->usersym=scr->globals;
  734.   }
  735.   scr->globals=NULL;
  736.   return(FPL_OK);
  737. }
  738.  
  739. /**************************************************************************
  740.  *
  741.  * int Script(struct Data *);
  742.  *
  743.  * Interprets an FPL program, very recursive. Returns progress in an integer,
  744.  * and the FPL program result code in the int scr->ret.
  745.  * USE AS FEW VARIABLES AS POSSIBLE to spare stack usage!
  746.  *
  747.  **********/
  748.  
  749. ReturnCode
  750. Script(struct Data *scr,  /* big FPL structure */
  751.        struct Expr *val,  /* result structure  */
  752.        short control,      /* control byte */
  753.        struct Condition *con)
  754. {
  755.   char declare=control&SCR_BRACE?1:0; /* declaration allowed? */
  756.   ReturnCode ret;           /* return value variable */
  757.   struct Condition *con2;      /* recursive check information! */
  758.   char brace=0; /* general TRUE/FALSE variable */
  759.   char *text; /* position storage variable */
  760.   long prg;   /* position storage variable */
  761.   long levels=scr->level; /* previous level spectra */
  762.   struct Identifier *ident; /* used when checking keywords */
  763.   long virprg=scr->virprg;
  764.   char *virfile=scr->virfile;
  765.   char done=FALSE; /* TRUE when exiting */
  766.   struct fplArgument *pass;
  767. #if defined(AMIGA) && defined(SHARED)
  768.   if(ret=CheckStack(scr, scr->stack_limit, FPLSTACK_MINIMUM)) {
  769.     if(ret==1)
  770.       return(FPLERR_OUT_OF_MEMORY);
  771.     else
  772.       return(FPLERR_OUT_OF_STACK);
  773.   }
  774. #endif
  775.  
  776.   if(control&(SCR_BRACE|SCR_FUNCTION)) {
  777.     /*
  778.      * New symbol declaration level!
  779.      */
  780.     scr->varlevel++;
  781.     CALL(AddLevel(scr));
  782.   }
  783.  
  784.   if(control&SCR_FUNCTION)
  785.     scr->level=0; /* number of levels to look for variables */
  786.   else if(control&SCR_BRACE)
  787.     scr->level++;
  788.  
  789.   while(!done) {
  790.     if(ret=Eat(scr)) {
  791.       if(scr->varlevel==1 && ret==FPLERR_UNEXPECTED_END)
  792.     /* It's OK! */
  793.     ret=FPL_OK;
  794.       if(scr->compiling)
  795.         COMPILE(COMP_END_OF_PROGRAM);
  796.       break;
  797.     }
  798.  
  799.     /* call the interval function */
  800.     if(scr->interfunc) {
  801.       if(scr->data=InterfaceCall(scr, scr->userdata, scr->interfunc))
  802.     CALL(Warn(scr, FPLERR_PROGRAM_STOPPED)); /* >warning< */
  803.     }
  804.  
  805.     switch(*scr->text) {
  806.     case CHAR_OPEN_BRACE:        /* open brace */
  807.       scr->text++;
  808.       if(scr->compiling)
  809.         COMPILE(COMP_START_OF_BLOCK);
  810.       CALL(Script(scr, val, SCR_NORMAL|SCR_BRACE, con));
  811.       if(CheckIt(scr, val, control, &ret)) {
  812.     CleanUp(scr, control, levels);
  813.     return(ret);
  814.       }
  815.       break;
  816.  
  817.     case CHAR_CLOSE_BRACE:
  818.       if(control&SCR_LOOP) {
  819.     if(control&SCR_BRACE) {
  820.       DelLocalVar(scr, &scr->locals); /* delete all local declarations */
  821.       scr->varlevel--;                /* previous variable level */
  822.       scr->level--;           /* previous level spectra */
  823.     }
  824.         CALL(Loop(scr, con, control, &brace));
  825.         if(!scr->compiling) {
  826.           if(brace) {
  827.             /* Yes! We should loop! */
  828.             if(control&SCR_BRACE) {
  829.               /* bring back the proper values */
  830.               scr->varlevel++;
  831.               scr->level++;
  832.               AddLevel(scr); /* restart this level! */
  833.               declare=TRUE;
  834.             }
  835.             scr->virprg=virprg;
  836.             scr->virfile=virfile;
  837.             continue;
  838.           }
  839.         } else
  840.           scr->text++; /* pass the brace! */
  841.         val->flags=0;
  842.       } else {
  843.     scr->text++;
  844.         val->flags=FPL_BRACE;
  845.     CleanUp(scr, control, levels);
  846.       }
  847.       if(scr->compiling) {
  848.         COMPILE(COMP_END_OF_BLOCK);
  849.         if(scr->varlevel == 0) {
  850.          /*
  851.           * This is the end of the ground function. We choose to continue
  852.           * anyway to scan the entire file!
  853.           * Then functions can again appear in the code, so we activate the
  854.           * 'declare' flag again!
  855.           */
  856.          declare = TRUE;
  857.          break;
  858.         }
  859.       }
  860.       return(FPL_OK);  /* return to calling function */
  861.  
  862.     case CHAR_SEMICOLON:
  863.       scr->text++;
  864.       break;
  865.  
  866.     default:
  867.       /*
  868.        * Time to parse the statement!
  869.        */
  870.  
  871.       text=scr->text;             /* store current position */
  872.       prg=scr->prg;
  873.       CALL(Getword(scr->buf, scr));  /* get next word */
  874.  
  875.       GetIdentifier(scr, scr->buf, &ident);
  876.  
  877.       if(ident && control&SCR_GLOBAL && declare) {
  878.     /* still on ground level and declaration allowed */
  879.     if(!(ident->flags&FPL_KEYWORD_DECLARE)) {
  880.       /*
  881.        * We move the pointer for the execution start position to
  882.        * this position.
  883.        */
  884.       scr->prog->startcol=text-(&scr->prog->program)[prg-1];
  885.       scr->prog->startprg=prg;
  886.       scr->prog->virprg=scr->virprg;
  887.       scr->prog->virfile=scr->virfile;
  888.  
  889.           if(scr->compiling)
  890.             COMPILE(COMP_START_OF_CODE);
  891.       
  892.       /*
  893.        * This is the end of the declaration phase. Now, let's
  894.        * check for that FPLTAG_INTERPRET tag to see if we should
  895.        * have a little fun or simply continue!
  896.        */
  897.       if(scr->interpret) {
  898.             done = TRUE;
  899.             continue;
  900.           }
  901.     }
  902.       }
  903.       if(ident && ident->flags&FPL_KEYWORD) {
  904.     if(ident->flags&FPL_KEYWORD_DECLARE) {
  905.       if(!declare) {
  906.         CALL(Warn(scr, FPLERR_ILLEGAL_DECLARE));   /* WARNING! */
  907.         /* declare it anyway!!! */
  908.       }      
  909.       CALL(Declare(val, scr, ident, control&SCR_GLOBAL?CON_DECLGLOB:0));
  910.       
  911.     } else {
  912.           if(scr->compiling)
  913.             COMPILESYMBOL(scr->buf);
  914.  
  915.       switch(ident->data.external.ID) {
  916.           case CMD_SWITCH:
  917.             CALL(Switch(scr, val, control, con));
  918.             if(CheckIt(scr, val, control, &ret)) {
  919.               CleanUp(scr, control, levels);
  920.               return(ret);
  921.             }
  922.             break;
  923.  
  924.           case CMD_CASE:    /* 'case' */
  925.             if(!control&SCR_SWITCH)
  926.               return FPLERR_ILLEGAL_STATEMENT; /* 'case' not within switch! */
  927.             /*
  928.              * This word can only be found if (control&SCR_SWITCH), and then
  929.              * we must just skip the "case XX:" text and continue.
  930.              */
  931.             CALL(GetEnd(scr, CHAR_COLON, 255, FALSE)); /* find colon! */
  932.             if(val->flags&FPL_STRING && !(val->flags&FPL_NOFREE) && val->val.str)
  933.             /* If there was a string return, it should be freed and the
  934.                string really held a string! */
  935.               FREE(val->val.str);
  936.             /* Check the colon */
  937.             if(scr->text[0]!=CHAR_COLON) {
  938.               CALL(Warn(scr, FPLERR_MISSING_COLON)); /* missing colon! */
  939.             } else
  940.               scr->text++;
  941.             break;
  942.  
  943.           case CMD_DEFAULT: /* 'default' */
  944.             if(!control&SCR_SWITCH)
  945.               return FPLERR_ILLEGAL_STATEMENT; /* 'default' not within switch! */
  946.             /*
  947.              * This word can only be found if (control&SCR_SWITCH), and then
  948.              * we must just skip the "default:" text and continue.
  949.              */
  950.             if(scr->text[0]!=CHAR_COLON) {
  951.               CALL(GetEnd(scr, CHAR_COLON, 255, FALSE));
  952.             } else
  953.               scr->text++;
  954.             break;
  955.  
  956.       case CMD_TYPEDEF:
  957.         CALL(Getword(scr->buf, scr));
  958.         CALL(GetIdentifier(scr, scr->buf, &ident));
  959.         if(!ret &&
  960.            (ident->data.external.ID==CMD_INT ||
  961.         ident->data.external.ID==CMD_STRING)) {
  962.               if(scr->compiling)
  963.                 COMPILESYMBOL(scr->buf);
  964.           CALL(Getword(scr->buf, scr));
  965.               if(scr->compiling)
  966.                 COMPILESYMBOL(scr->buf);
  967.           text=(void *)ident;
  968.           GETMEM(ident, sizeof(struct Identifier));
  969.           *ident=*(struct Identifier *)text; /* copy entire structure! */
  970.           GETMEM(ident->name, strlen(scr->buf)+1);
  971.           strcpy(ident->name, scr->buf);
  972.           ident->flags&=~FPL_INTERNAL_FUNCTION; /* no longer any internal
  973.                                declarator symbol! */
  974.           CALL(AddVar(scr, ident, &scr->locals));
  975.         } else {
  976.           CALL(Warn(scr, FPLERR_IDENTIFIER_NOT_FOUND));
  977.           /* then just skip this statement! */
  978.           CALL(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE));
  979.         }
  980.         break;
  981.       case CMD_RETURN:
  982.       case CMD_EXIT:
  983.         Eat(scr);
  984.         if(*scr->text!=CHAR_SEMICOLON) { /* no return X  */
  985.           brace=*scr->text==CHAR_OPEN_PAREN; /* not required! */
  986.           scr->text+=brace;
  987.           
  988.               if(scr->compiling)
  989.                 COMPILE(COMP_START_OF_EXPR);
  990.  
  991.           /*
  992.            * If return()ing from a function when scr->strret is TRUE,
  993.            * return a string.
  994.            */
  995.           if((scr->strret && ident->data.external.ID==CMD_RETURN) ||
  996.                  (scr->string_return && ident->data.external.ID==CMD_EXIT)) {
  997.         CALL(Expression(val, scr, CON_NORMAL, NULL));
  998.         if(!(val->flags&FPL_STRING)) {
  999.           /* that wasn't a string! */
  1000.           CALL(Warn(scr, FPLERR_ILLEGAL_PARAMETER));
  1001.         } else {
  1002.           /* It was a string! */
  1003.           if(val->flags&FPL_NOFREE) {
  1004.             /*
  1005.              * We're only refering to another string! We can't
  1006.              * allow that since that string might be a local
  1007.              * variable, and all such are about to be deleted now!
  1008.              */
  1009.             struct fplStr *string=NULL;
  1010.             GETMEM(string, val->val.str->len+sizeof(struct fplStr));
  1011.             memcpy(string,
  1012.                val->val.str,
  1013.                val->val.str->len+sizeof(struct fplStr));
  1014.             string->alloc=val->val.str->len;
  1015.             val->val.str=string;
  1016.             val->flags&=~FPL_NOFREE;
  1017.           }
  1018.         }
  1019.  
  1020.           } else {
  1021.         CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1022.           }
  1023.               if(scr->compiling)
  1024.                 COMPILE(COMP_END_OF_EXPR);
  1025.           if(brace)
  1026.         if(*scr->text!=CHAR_CLOSE_PAREN) {
  1027.           CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  1028.           /* continue */
  1029.         } else
  1030.           scr->text++;
  1031.         } else {
  1032.           val->val.val=0;
  1033.           val->flags=0;
  1034.         }
  1035.         scr->FPLret=val->val.val;    /* set return code! */
  1036.         if(ident->data.external.ID==CMD_RETURN) {
  1037.           ret=FPL_OK;
  1038.         } else
  1039.           ret=FPL_EXIT_OK; /* This will make us return through it all! */
  1040.  
  1041.             val->flags|=FPL_RETURN; /* inform calling function */
  1042.  
  1043.             if(scr->compiling)
  1044.               /* compiling, no function actually does anything! */
  1045.               break;
  1046.         CleanUp(scr, control, levels);
  1047.         return(ret);
  1048.       case CMD_IF:        /* if() */
  1049.       case CMD_WHILE:    /* while() */
  1050.         Eat(scr);
  1051.         
  1052.         /*********************
  1053.           
  1054.           PARSE CONDITION
  1055.           
  1056.           *******************/
  1057.         
  1058.         
  1059.         if(*scr->text!=CHAR_OPEN_PAREN) {
  1060.           CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  1061.           /* please, go on! */
  1062.         } else
  1063.           scr->text++;
  1064.  
  1065.             if(scr->compiling)
  1066.               COMPILE(COMP_START_OF_EXPR);
  1067.  
  1068.         GETMEM(con2, sizeof(struct Condition));
  1069.  
  1070.         /* save check position! */
  1071.         con2->check=scr->text;
  1072.         con2->checkl=scr->prg;
  1073.         
  1074.         CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1075.         if(*scr->text!=CHAR_CLOSE_PAREN) {
  1076.           CALL(Warn(scr, FPLERR_MISSING_PARENTHESES)); /* >warning< */
  1077.           /* continue */
  1078.         } else 
  1079.           scr->text++;
  1080.         
  1081.             if(scr->compiling)
  1082.               COMPILE(COMP_END_OF_EXPR);
  1083.  
  1084.         if(val->val.val || scr->compiling) {
  1085.           /********************
  1086.         
  1087.         PARSE STATMENT
  1088.         
  1089.         ******************/
  1090.           
  1091.           Eat(scr);
  1092.           scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
  1093.           con2->bracetext=scr->text;
  1094.           con2->braceprg=scr->prg;
  1095.               if(scr->compiling)
  1096.                 COMPILE(COMP_START_OF_BLOCK);
  1097.           CALL(Script(scr, val,
  1098.               (brace?SCR_BRACE:0)|
  1099.               (ident->data.external.ID==CMD_WHILE?SCR_WHILE:SCR_IF),
  1100.               con2));
  1101.           if(CheckIt(scr, val, control, &ret)) {
  1102.         FREE(con2);
  1103.         CleanUp(scr, control, levels);
  1104.         return(ret);
  1105.           }
  1106.           brace=TRUE;
  1107.         } else {
  1108.           /********************
  1109.         
  1110.         SKIP STATEMENT
  1111.         
  1112.         ******************/
  1113.           
  1114.           CALL(SkipStatement(scr));
  1115.           brace=FALSE;
  1116.         }
  1117.         
  1118.         text=scr->text;
  1119.         prg=scr->prg;
  1120.         
  1121.         Getword(scr->buf, scr);
  1122.         
  1123.         if(!strcmp("else", scr->buf) && brace && !scr->compiling) {
  1124.           /********************
  1125.         
  1126.         SKIP STATEMENT
  1127.         
  1128.         ******************/
  1129.           
  1130.           CALL(SkipStatement(scr));
  1131.         } else if(!strcmp("else", scr->buf) && (!brace || scr->compiling)) {
  1132.           /********************
  1133.         
  1134.         PARSE STATMENT
  1135.         
  1136.         ******************/
  1137.           
  1138.               if(scr->compiling)
  1139.                 COMPILESYMBOL("else");
  1140.           Eat(scr);
  1141.           scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
  1142.           con2->bracetext=scr->text;
  1143.           con2->braceprg=scr->prg;
  1144.               if(scr->compiling)
  1145.                 COMPILE(COMP_START_OF_BLOCK);
  1146.           CALL(Script(scr, val, (brace?SCR_BRACE:0), con2));
  1147.           if(CheckIt(scr, val, control, &ret)) {
  1148.         FREE(con2);
  1149.         CleanUp(scr, control, levels);
  1150.         return(ret);
  1151.           }
  1152.         } else {
  1153.           scr->text=text;
  1154.           scr->prg=prg;
  1155.         }
  1156.         FREE(con2);
  1157.         break;
  1158.       case CMD_BREAK:
  1159.         val->val.val=1;    /* default is break 1 */
  1160.         Eat(scr);
  1161.         /*
  1162.          * Check if break out of several statements.
  1163.          */
  1164.         if(*scr->text!=CHAR_SEMICOLON) {
  1165.           /* Get the result of the expression. */
  1166.           brace=*scr->text==CHAR_OPEN_PAREN;
  1167.           scr->text+=brace;
  1168.               if(scr->compiling)
  1169.                 COMPILE(COMP_START_OF_EXPR);
  1170.           CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1171.           if(brace)
  1172.         if(*scr->text!=CHAR_CLOSE_PAREN) {
  1173.           CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  1174.         } else
  1175.           scr->text++;
  1176.           else if(val->val.val<0) {
  1177.         CALL(Warn(scr, FPLERR_ILLEGAL_BREAK));
  1178.         val->val.val=1; /* reset! */
  1179.           }
  1180.         }
  1181.         /*
  1182.          * Go to end of statement!!! If this was started without
  1183.          * SCR_BRACE set, we're already at the end of the statement!
  1184.          */
  1185.         
  1186.             if(scr->compiling) {
  1187.               /* When compiling, do no "real" break! */
  1188.               scr->text++;
  1189.           break;
  1190.             }
  1191.         if(control&SCR_BRACE)
  1192.           CALL(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE));
  1193.         if(control&SCR_DO)
  1194.           /* if it was inside a do statement, pass the ending `while' */
  1195.           CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  1196.         val->flags|=FPL_BREAK;
  1197.         if(control&(SCR_LOOP|SCR_SWITCH))
  1198.           if(!--val->val.val)
  1199.         val->flags&=~FPL_BREAK; /* only this break! */
  1200.         CleanUp(scr, control, levels);
  1201.         return(FPL_OK);
  1202.       case CMD_CONTINUE:
  1203.         if(*scr->text!=CHAR_SEMICOLON) {
  1204.           CALL(Warn(scr, FPLERR_MISSING_SEMICOLON));  /* >warning< */
  1205.         } else
  1206.           scr->text++;
  1207.             if(scr->compiling)
  1208.               break; /* just continue on the next position! */
  1209.         if(control&SCR_LOOP) {
  1210.           /* loop! */
  1211.           if(control&SCR_BRACE && !scr->compiling) {
  1212.         DelLocalVar(scr, &scr->locals); /* delete all locals */
  1213.         scr->varlevel--;                /* previous variable level */
  1214.         scr->level--;                     /* previous level spectra */
  1215.           }
  1216.           CALL(Loop(scr, con, control, &brace));
  1217.           if(!brace) {
  1218.         /*
  1219.          * The result of the condition check was FALSE. Move to the end
  1220.          * of the block and continue execution there!
  1221.          */
  1222.         
  1223.         if(control&SCR_BRACE) {
  1224.           /* braces */
  1225.           CALL(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE));
  1226.         } else {
  1227.           /* no braces! */
  1228.           CALL(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE));
  1229.         }
  1230.         val->flags=0;
  1231.           } else {
  1232.         if(control&SCR_BRACE) {
  1233.           /* bring back the proper values */
  1234.           scr->varlevel++;
  1235.           scr->level++;
  1236.           AddLevel(scr); /* restart this level! */
  1237.           declare=TRUE;
  1238.         }
  1239.         scr->virprg=virprg;
  1240.         scr->virfile=virfile;
  1241.         continue;
  1242.           }
  1243.         } else {
  1244.           /* it's no looping statement! */
  1245.           val->flags=FPL_CONTINUE;
  1246.           CleanUp(scr, control, levels);
  1247.         }
  1248.         return(FPL_OK);
  1249.       case CMD_DO:
  1250.         CALL(Eat(scr));
  1251.         GETMEM(con2, sizeof(struct Condition));
  1252.         scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
  1253.         con2->bracetext=scr->text;
  1254.         con2->braceprg=scr->prg;
  1255.         con2->check=NULL;
  1256.             if(scr->compiling)
  1257.               COMPILE(COMP_START_OF_BLOCK);
  1258.         CALL(Script(scr, val, SCR_DO|(brace?SCR_BRACE:0), con2));
  1259.         FREE(con2);
  1260.         if(CheckIt(scr, val, control, &ret)) {
  1261.           CleanUp(scr, control, levels);
  1262.           return(ret);
  1263.         }
  1264.         break;
  1265.       case CMD_FOR:
  1266.         Eat(scr);
  1267.         scr->text++;
  1268.             if(scr->compiling)
  1269.               COMPILE(COMP_START_OF_EXPR);
  1270.         CALL(Expression(val, scr, CON_GROUNDLVL|CON_SEMICOLON, NULL));
  1271.         
  1272.         if(*scr->text!=CHAR_SEMICOLON) {
  1273.           CALL(Warn(scr, FPLERR_MISSING_SEMICOLON));
  1274.         } else
  1275.           scr->text++;
  1276.         GETMEM(con2, sizeof(struct Condition));
  1277.  
  1278.         con2->check=scr->text;
  1279.         con2->checkl=scr->prg;
  1280.             if(scr->compiling)
  1281.               COMPILE(COMP_START_OF_EXPR);
  1282.         CALL(Expression(val, scr, CON_GROUNDLVL|CON_SEMICOLON|CON_NUM, NULL));
  1283.         
  1284.         if(*scr->text!=CHAR_SEMICOLON) {
  1285.           CALL(Warn(scr, FPLERR_MISSING_SEMICOLON));
  1286.         } else
  1287.           scr->text++;
  1288.         con2->postexpr=scr->text;
  1289.         con2->postexprl=scr->prg;
  1290.         
  1291.             if(scr->compiling) {
  1292.               /* Do the last expression too!! */
  1293.               if(scr->compiling)
  1294.                 COMPILE(COMP_START_OF_EXPR);
  1295.               CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1296.               if(*scr->text!=CHAR_CLOSE_PAREN) {
  1297.                 CALL(Warn(scr, FPLERR_MISSING_SEMICOLON));
  1298.               } else
  1299.                 scr->text++; /* pass the closing parenthesis! */
  1300.               val->val.val= TRUE; /* always compile everything! */
  1301.             }
  1302.             else {
  1303.           /*
  1304.            * Pass the last expression:
  1305.            */
  1306.           CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, FALSE));
  1307.         }
  1308.         if(!val->val.val) {
  1309.           /* We shouldn't enter the loop! Go to end of block:*/
  1310.           CALL(SkipStatement(scr));
  1311.           FREE(con2);
  1312.         } else {
  1313.           CALL(Eat(scr));
  1314.           scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
  1315.           con2->bracetext=scr->text;
  1316.           con2->braceprg=scr->prg;
  1317.               if(scr->compiling)
  1318.                 COMPILE(COMP_START_OF_BLOCK);
  1319.           CALL(Script(scr, val, (brace?SCR_BRACE:0)|SCR_FOR, con2));
  1320.           FREE(con2);
  1321.           if(CheckIt(scr, val, control, &ret)) {
  1322.         CleanUp(scr, control, levels);
  1323.         return(ret);
  1324.           }
  1325.         }
  1326.         break;
  1327.       case CMD_RESIZE:
  1328.         CALL(Resize(scr, val, control));
  1329.         break;
  1330.       } /* switch(keyword) */
  1331.         } /* if it wasn't a declaring keyword */
  1332.       } else {
  1333.         if(scr->compiling)
  1334.           COMPILESYMBOL(scr->buf);
  1335.     declare=FALSE;
  1336.     CALL(Expression(val, scr, CON_ACTION|CON_IDENT, ident));
  1337.     if(val->flags&FPL_STRING && !(val->flags&FPL_NOFREE) && val->val.str)
  1338.       /* If there was a string return, it should be freed and the
  1339.          string really held a string! */
  1340.       FREE(val->val.str);
  1341.     if(*scr->text!=CHAR_SEMICOLON) {
  1342.       CALL(Warn(scr, FPLERR_MISSING_SEMICOLON)); /* >warning< */
  1343.     } else
  1344.       scr->text++;
  1345.       }
  1346.     } /* switch (*scr->text) */
  1347.   
  1348.     if(!(control&(SCR_BRACE|SCR_SWITCH))) {
  1349.       if(scr->compiling)
  1350.         COMPILE(COMP_END_OF_BLOCK);
  1351.       if(control&SCR_LOOP) {
  1352.     CALL(Loop(scr, con, control, &brace));
  1353.     if(brace && !scr->compiling) {
  1354.       /* Yes! We should loop! */
  1355.       if(control&SCR_BRACE) {
  1356.         /* bring back the proper values */
  1357.         scr->varlevel++;
  1358.         scr->level++;
  1359.         AddLevel(scr); /* restart this level! */
  1360.         declare=TRUE;
  1361.       }
  1362.       scr->virprg=virprg;
  1363.       scr->virfile=virfile;
  1364.       continue;
  1365.     }
  1366.     val->flags=0;
  1367.     ret=FPL_OK;
  1368.     break; /* return to calling function */
  1369.       } else 
  1370.     break;
  1371.     }
  1372.   } /* loop! */
  1373.  
  1374.   /*
  1375.    * Check for that FPLTAG_INTERPRET tag!
  1376.    */
  1377.   if(!ret && scr->interpret) {
  1378.     /* an alternative main program is specified */
  1379.     GETMEM(pass, sizeof(struct fplArgument));
  1380.     pass->ID=FNC_INTERPRET;
  1381.     text = scr->interpret;
  1382.     pass->argv=(void **)&text;
  1383.     pass->key=scr;
  1384.     CALL(functions(pass));
  1385.  
  1386.     CleanUp(scr, control, levels);
  1387.  
  1388.     /* we're done for this time, exit! */
  1389.     ret = FPL_EXIT_OK;
  1390.   }
  1391.  
  1392.   CleanUp(scr, control, levels);
  1393.   return(ret);
  1394. }
  1395.  
  1396. static ReturnCode INLINE
  1397. Switch(struct Data *scr,
  1398.        struct Expr *val,
  1399.        short control,
  1400.        struct Condition *con)
  1401. {
  1402.   ReturnCode ret;
  1403.   struct fplStr *string;
  1404.   long value;
  1405.   char strtype=FALSE;
  1406.   char breakout=FALSE;
  1407.  
  1408.   char end=FALSE; /* we have not found the end position */
  1409.  
  1410.   long bprg;
  1411.   char *btext;
  1412.   long bvirprg;
  1413.   char *bvirfile;
  1414.  
  1415.   long dprg=-1;
  1416.   char *dtext;
  1417.   long dvirprg;
  1418.   char *dvirfile;
  1419.  
  1420.   CALL(Eat(scr)); /* eat whitespace */
  1421.  
  1422.   /* Check the open parenthesis */
  1423.   if(scr->text[0]!=CHAR_OPEN_PAREN) {
  1424.     CALL(Warn(scr, FPLERR_MISSING_PARENTHESES)); /* >warning< */
  1425.   } else
  1426.     scr->text++;
  1427.  
  1428.   /* Get expression, string or int, static or dynamic! */
  1429.   CALL(Expression(val, scr, CON_NORMAL, NULL));
  1430.  
  1431.   if(val->flags&FPL_STRING) {
  1432.     /* there was a string statement! */
  1433.     string = val->val.str;
  1434.     if(string)
  1435.       strtype=2;
  1436.     else
  1437.       strtype= 1;
  1438.  
  1439.   } else {
  1440.     /* there was an integer expression */
  1441.     value = val->val.val;
  1442.   }
  1443.  
  1444.   /* Check the close parenthesis */
  1445.   if(scr->text[0]!=CHAR_CLOSE_PAREN) {
  1446.     CALL(Warn(scr, FPLERR_MISSING_PARENTHESES)); /* >warning< */
  1447.   } else
  1448.     scr->text++;
  1449.  
  1450.   CALL(Eat(scr)); /* eat whitespace */
  1451.  
  1452.   /* Check the open brace */
  1453.   if(scr->text[0]!=CHAR_OPEN_BRACE) {
  1454.     CALL(Warn(scr, FPLERR_MISSING_BRACE)); /* >warning< */
  1455.   } else
  1456.     scr->text++;
  1457.  
  1458.   while(!(ret=Eat(scr))) {
  1459.     if(!Getword(scr->buf, scr)) {
  1460.       if(!strcmp("case", scr->buf)) {
  1461.         /* This is a valid case-line coming up! */
  1462.   
  1463.         /* Get expression, string or int! */
  1464.         CALL(Expression(val, scr, strtype?CON_STRING:CON_NUM, NULL));
  1465.         if(strtype) {
  1466.           /*
  1467.            * String comparison:
  1468.            */
  1469.           value = val->val.str?val->val.str->len:0;
  1470.  
  1471.           if(value == (string?string->len:0)) {
  1472.  
  1473.             if(value) {
  1474.               if(!memcmp(val->val.str->string, string->string, value)) {
  1475.                 /* match! */
  1476.                 breakout=TRUE;
  1477.               }
  1478.             } else
  1479.               breakout=TRUE;
  1480.           }
  1481.           if(!val->flags&FPL_NOFREE)
  1482.             FREE(val->val.str);
  1483.           if(breakout)
  1484.             break;
  1485.           else
  1486.             scr->text++; /* pass the ';' */
  1487.         } else {
  1488.           /*
  1489.            * Integer comparison:
  1490.            */
  1491.           if(val->val.val == value) {
  1492.             breakout = TRUE;
  1493.             break;
  1494.           } else
  1495.             scr->text++; /* pass the ';' */
  1496.         }
  1497.       } else if(!strcmp("default", scr->buf)) {
  1498.         /*
  1499.          * Store the default position to make it possible to return to if
  1500.          * necessary!
  1501.          */
  1502.  
  1503.     if(dprg>=0)
  1504.       return FPLERR_ILLEGAL_STATEMENT; /* dual 'default' specified! */
  1505.  
  1506.         dprg = scr->prg;
  1507.         dtext = scr->text;
  1508.         dvirprg = scr->virprg;
  1509.         dvirfile = scr->virfile;
  1510.   
  1511.       } else {
  1512.         /*
  1513.          * Pass the statement!
  1514.          */
  1515.         CALL(SkipStatement(scr));
  1516.       }
  1517.     } else {
  1518.       /* we didn't get any word */
  1519.       if(scr->text[0]==CHAR_CLOSE_BRACE) {
  1520.         /*
  1521.          * We hit the end without finding our 'case'! Return to the
  1522.          * 'default', if any! Store the position to be able to quickly
  1523.          * jump down to it again after the possible case-statement.
  1524.          */
  1525.  
  1526.         scr->text++; /* pass the closing brace */
  1527.         if(dprg<0)
  1528.           /* we didn't find any 'default' */
  1529.           break;
  1530.         bprg = scr->prg;
  1531.         btext = scr->text;
  1532.         bvirprg = scr->virprg;
  1533.         bvirfile = scr->virfile;
  1534.       
  1535.         end=TRUE; /* we have found the end! */
  1536.  
  1537.         scr->prg=dprg;
  1538.         scr->text=dtext;
  1539.         scr->virprg=dvirprg;
  1540.         scr->virfile=dvirfile;
  1541.         breakout = TRUE;
  1542.         break;
  1543.  
  1544.       } else {
  1545.         /*
  1546.          * Pass the statement!
  1547.          */
  1548.         CALL(SkipStatement(scr));
  1549.       }
  1550.     }
  1551.   }
  1552.   if(breakout) {
  1553.     /* we did break out on any of the 'case' or 'default' label lines,
  1554.        pass the colon!
  1555.      */
  1556.     /* CALL(Eat(scr));  eating whitespace shouldn't be necessary here */
  1557.  
  1558.     /* Check the colon */
  1559.     if(scr->text[0]!=CHAR_COLON) {
  1560.       CALL(Warn(scr, FPLERR_MISSING_COLON)); /* missing colon */
  1561.     } else
  1562.       scr->text++;
  1563.  
  1564.     /*
  1565.      * run this statement all the way until break or '}'!
  1566.      */
  1567.  
  1568.     CALL(Script(scr, val, SCR_SWITCH, con));
  1569.  
  1570.     if(!(val->flags&FPL_BRACE)) {
  1571.       /* we didn't run into the closing brace! */
  1572.       
  1573.       /*
  1574.        * Go to the end of the switch()-statement.
  1575.        */
  1576.       if(!end) {
  1577.         /* we'll have to search for it! */
  1578.         CALL(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE));
  1579.       } else {
  1580.         scr->prg=bprg;
  1581.         scr->text=btext;
  1582.         scr->virprg=dprg;
  1583.         scr->virfile=dvirfile;
  1584.       }
  1585.     }
  1586.  
  1587.   }
  1588.   return ret;
  1589. }
  1590.  
  1591. static ReturnCode INLINE
  1592. Declare(struct Expr *val,
  1593.     struct Data *scr,
  1594.     struct Identifier *ident,
  1595.     long start)            /* start flags */
  1596. {
  1597.   ReturnCode ret;
  1598.   long flags=start;
  1599.   char *text;
  1600.   long prg;
  1601.   do {
  1602.     switch(ident->data.external.ID) {
  1603.     case CMD_EXPORT:
  1604.       flags|=CON_DECLEXP;
  1605.       break;
  1606.     case CMD_STRING:
  1607.       flags|=CON_DECLSTR;
  1608.       break;
  1609.     case CMD_INT:
  1610.       flags|=CON_DECLINT;
  1611.       if(ident->flags&FPL_SHORT_VARIABLE)
  1612.     flags|=CON_DECL16;
  1613.       else if(ident->flags&FPL_CHAR_VARIABLE)
  1614.     flags|=CON_DECL8;
  1615.       break;
  1616.     case CMD_VOID:
  1617.       flags|=CON_DECLVOID;
  1618.       break;
  1619.     case CMD_AUTO:
  1620.     case CMD_REGISTER:
  1621.       flags&=~(CON_DECLEXP|CON_DECLGLOB);
  1622.       break;
  1623.     case CMD_CONST:
  1624.       flags|=CON_DECLCONST;
  1625.       break;
  1626.     case CMD_STATIC:
  1627.       flags|=CON_DECLSTATIC;
  1628.       break;
  1629.     }
  1630.     if(scr->compiling && !(ident->flags&FPL_IGNORE))
  1631.       COMPILESYMBOL(scr->buf);
  1632.     text=scr->text;
  1633.     prg=scr->prg;
  1634.     CALL(Getword(scr->buf, scr));
  1635.     ret=GetIdentifier(scr, scr->buf, &ident);
  1636.   } while(!ret && ident->flags&FPL_KEYWORD_DECLARE);
  1637.  
  1638.   scr->text=text;
  1639.   scr->prg=prg;
  1640.  
  1641.   if(!(flags&CON_DECLARE))
  1642.     flags|=CON_DECLINT; /* integer declaration is default! */
  1643.  
  1644.   CALL(Expression(val, scr, CON_GROUNDLVL|flags, NULL));
  1645.   if(*scr->text!=CHAR_SEMICOLON &&
  1646.      (!(val->flags&FPL_DEFUNCTION) || *scr->text!=CHAR_CLOSE_BRACE)) {
  1647.     CALL(Warn(scr, FPLERR_MISSING_SEMICOLON)); /* >warning< */
  1648.   } else
  1649.     scr->text++;
  1650.   return(FPL_OK);
  1651. }
  1652.  
  1653.  
  1654.  
  1655. /**********************************************************************
  1656.  *
  1657.  * Resize()
  1658.  *
  1659.  * This function resizes a variable array to the new given size.
  1660.  *
  1661.  *****/
  1662.  
  1663. static ReturnCode INLINE Resize(struct Data *scr, struct Expr *val, char control)
  1664. {
  1665.   char num=0; /* number of dimensions */
  1666.   long *dims; /* dimension array */
  1667.   char i; /* counter to max MAX_DIMS */
  1668.   int size, min;
  1669.   void *tempvars;
  1670.   struct fplVariable *var;
  1671.   struct Identifier *ident;
  1672.   ReturnCode ret;
  1673.   CALL(Getword(scr->buf, scr));
  1674.   CALL(GetIdentifier(scr, scr->buf, &ident));
  1675.   var=&ident->data.variable;
  1676.  
  1677.   if(!(ident->flags&FPL_VARIABLE) || !var->num) {
  1678.     CALL(Warn(scr, FPLERR_ILLEGAL_RESIZE));
  1679.     CALL(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE));
  1680.   }
  1681.       
  1682.   if(scr->compiling)
  1683.     COMPILESYMBOL(scr->buf);
  1684.   Eat(scr);
  1685.   GETMEM(dims, MAX_DIMS*sizeof(long));
  1686.  
  1687.   do {
  1688.     if(*scr->text!=CHAR_OPEN_BRACKET) {
  1689.       CALL(Warn(scr, FPLERR_MISSING_BRACKET)); /* >warning< */
  1690.     } else
  1691.       scr->text++; /* pass the open bracket */
  1692.     /* eval the expression: */
  1693.     CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1694.     if(*scr->text++!=CHAR_CLOSE_BRACKET)
  1695.       /* no close bracket means error */
  1696.       return(FPLERR_MISSING_BRACKET); /* missing bracket */
  1697.     else if(val->val.val<(control&CON_DECLARE?1:0))
  1698.       /* illegal result of the expression */
  1699.       return(FPLERR_ILLEGAL_ARRAY);
  1700.     
  1701.     dims[num++]=val->val.val; /* Add another dimension */
  1702.     if(num==MAX_DIMS) {
  1703.       /* if we try to declare too many dimensions... */
  1704.       CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  1705.  
  1706.       /* Get to the end of this absurd resize! */
  1707.       CALL(GetEnd(scr, CHAR_SEMICOLON, 255, !(*scr->text==CHAR_SEMICOLON)));
  1708.       break;
  1709.     }
  1710.     /*
  1711.      * Go on as long there are brackets,
  1712.      */
  1713.   } while(*scr->text==CHAR_OPEN_BRACKET);
  1714.   
  1715.   size=dims[0]; /* array size */
  1716.   for(i=1; i<num; i++)
  1717.     size*=dims[i];
  1718.  
  1719.   min=MIN(size, var->size); /* number of variables to copy! */
  1720.       
  1721.   GETMEM(tempvars, size * sizeof(void *)); /* data adjust! */
  1722.   memcpy(tempvars, var->var.str, min * sizeof(void *));
  1723.   if(size>var->size)
  1724.     /*
  1725.      * If we create a few more than before, empty that data!
  1726.      */
  1727.     memset((char *)tempvars+var->size*sizeof(void *), 0,
  1728.        (size-var->size)*sizeof(void *));
  1729.  
  1730.   if(ident->flags&FPL_STRING_VARIABLE)
  1731.     for(i=min; i<var->size; i++) {
  1732.       if(var->var.str[i])
  1733.     FREE(var->var.str[i]);
  1734.     }
  1735.  
  1736.   FREE(var->var.val);
  1737.   var->var.val= tempvars;
  1738.   
  1739.   var->size= size;
  1740.   FREE(var->dims);
  1741.   GETMEM(var->dims, num * sizeof(long));
  1742.   memcpy(var->dims, dims, num * sizeof(long));
  1743.  
  1744.   FREE(dims);
  1745.   return(FPL_OK);
  1746. }
  1747.  
  1748.  
  1749. /************************************************************************
  1750.  *
  1751.  * int GetEnd(struct Data *, char, char, char)
  1752.  *
  1753.  * Makes the current position to be the one right after the character
  1754.  * you wanna search for.
  1755.  *
  1756.  * Returns error code.
  1757.  *
  1758.  *****/
  1759.  
  1760. ReturnCode
  1761. GetEnd(struct Data *scr, /* giant script structure */
  1762.        char leta,     /* what character you do wanna find */
  1763.        char motsats,     /* the opposite character do the one above */
  1764.        char outside)     /* TRUE/FALSE if outside an opposite version */
  1765. {
  1766.   ReturnCode ret;
  1767.   char quot=FALSE, find=1-outside;
  1768.   long junk; /* only for the ReturnChar() function */
  1769.   long prg=scr->prg;
  1770.   char *text=scr->text;
  1771.   char check;
  1772.   if(scr->compiling)
  1773.     COMPILE(COMP_ERROR);
  1774.   while(scr->prg<=scr->prog->lines) {
  1775.     check=*scr->text;
  1776.     if(check==leta) {
  1777.       scr->text++;
  1778.       if(!quot && !--find)
  1779.     return(FPL_OK);
  1780.     } else if(check==motsats) {
  1781.       if(!quot)
  1782.     find++;
  1783.       scr->text++;
  1784.     } else if(check==CHAR_QUOTATION_MARK) {
  1785.       scr->text++;
  1786.       if(GetEnd(scr, CHAR_QUOTATION_MARK, (char)255, FALSE))
  1787.     return(FPLERR_SYNTAX_ERROR); /* missing quotation mark */
  1788.     } else if(check==CHAR_APOSTROPHE && leta!=CHAR_QUOTATION_MARK) {
  1789.       scr->text++;
  1790.       CALL(ReturnChar(scr, &junk, FALSE));
  1791.       if(CHAR_APOSTROPHE!=*scr->text++)
  1792.     return(FPLERR_MISSING_APOSTROPHE);
  1793.     } else if(check==CHAR_ASCII_ZERO) {
  1794.       CALL(Newline(scr));
  1795.     } else if(leta==CHAR_QUOTATION_MARK && check == CHAR_BACKSLASH) {
  1796.       CALL(ReturnChar(scr, &junk, TRUE));
  1797.     } else {
  1798.       if(check==CHAR_NEWLINE)
  1799.     scr->virprg++;
  1800.       scr->text++;
  1801.       if(leta!=CHAR_QUOTATION_MARK && Eat(scr))
  1802.         /* we only call Eat() if this is *not* a string passing! */
  1803.     break;
  1804.     }
  1805.   }
  1806.   scr->text=text;
  1807.   scr->prg=prg;
  1808.   return(FPLERR_MISSING_PARENTHESES);
  1809. }
  1810.  
  1811. /**********************************************************************
  1812.  *
  1813.  * Getword()
  1814.  *
  1815.  * Store next word in a buffer. Returns error code!
  1816.  *
  1817.  *******/
  1818.  
  1819. ReturnCode Getword(char *buffer, struct Data *scr)
  1820. {
  1821.   ReturnCode ret;
  1822.   char len=0;
  1823.   if(ret=Eat(scr))
  1824.     ;
  1825.   else if(!ALPHA(*scr->text))
  1826.     ret=FPLERR_SYNTAX_ERROR; /* non-alpha char found where alpha is supposed */
  1827.   else
  1828.     do {
  1829.       if(len<IDENTIFIER_LEN) {
  1830.     /*
  1831.      * With the length check above, we can use identifiers with
  1832.      * _any_ length. There are only IDENTIFIER_LEN number of
  1833.      * significant characters!
  1834.      *
  1835.      */
  1836.     len++;
  1837.     *buffer++=*scr->text++;
  1838.       }
  1839.     } while(ALPHANUM(*scr->text));
  1840.   *buffer=0;
  1841.   return(ret);
  1842. }
  1843.  
  1844. /**********************************************************************
  1845.  *
  1846.  * int Eatcomment(struct Data *);
  1847.  *
  1848.  * Jumps to the end of the comment we're standing on.
  1849.  *
  1850.  *******/
  1851.  
  1852. static ReturnCode INLINE Eatcomment(struct Data *scr)
  1853. {
  1854.   ReturnCode ret;
  1855.   long nums=0;
  1856.   scr->text+=2;
  1857.   while(scr->prg<=scr->prog->lines) {
  1858.     switch(scr->text[0]) {
  1859.     case CHAR_MULTIPLY:
  1860.       if(scr->text[1]==CHAR_DIVIDE) {
  1861.     scr->text+=2;
  1862.         if(nums--)
  1863.           break;
  1864.     return(FPL_OK);
  1865.       } else
  1866.     scr->text++;
  1867.       break;
  1868.     case CHAR_ASCII_ZERO:
  1869.       CALL(Newline(scr));
  1870.       break;
  1871.     case CHAR_NEWLINE:
  1872.       scr->text++;
  1873.       scr->virprg++; /* stepped down another virutal line! */
  1874.       /*
  1875.        * Place to debug-hook!
  1876.        */
  1877.       if(scr->newline_hook) {
  1878.     CALL(InterfaceCall(scr, scr, scr->newline_hook));
  1879.       }
  1880.       break;
  1881.     case CHAR_DIVIDE:
  1882.       if(scr->flags&FPLDATA_NESTED_COMMENTS && scr->text[1]==CHAR_MULTIPLY) {
  1883.         nums++;
  1884.         scr->text+=2;
  1885.         break;
  1886.       }
  1887.     default:
  1888.       scr->text++;
  1889.       break;
  1890.     }
  1891.   }
  1892.   return(FPLERR_UNBALANCED_COMMENT);
  1893. }
  1894.  
  1895. /**********************************************************************
  1896.  *
  1897.  * int Eat(struct Data *);
  1898.  *
  1899.  * This eats all whitespaces, new lines and comments
  1900.  *
  1901.  * Returns error code.
  1902.  *
  1903.  *******/
  1904.  
  1905. ReturnCode Eat(struct Data *scr)
  1906. {
  1907.   ReturnCode ret;
  1908.   char new=0;
  1909.   while(1) {
  1910.     switch(*scr->text) {
  1911.     case CHAR_NEWLINE:
  1912.       scr->text++;
  1913.       scr->virprg++; /* stepped down another virutal line! */
  1914.       /*
  1915.        * Place to debug-hook!
  1916.        */
  1917.       if(scr->newline_hook) {
  1918.     CALL(InterfaceCall(scr, scr, scr->newline_hook));
  1919.       }
  1920.       new=1;
  1921.       break;
  1922.     case CHAR_ASCII_ZERO:
  1923.       CALL(Newline(scr));
  1924.       /* This really confuses our virtual line counter! */
  1925.       break;
  1926.     case CHAR_HASH:
  1927.       if(new) {
  1928.     /* This is the first 'real' character after a newline! That means
  1929.        this could be a valid #line-instruction! */
  1930.     scr->text++; /* pass the hash */
  1931.     if(!Getword(scr->buf, scr) && strcmp(scr->buf, "line")) {
  1932.       /* If there is a word here, it must be "line", or we skip
  1933.          the line! */
  1934.       while (*++scr->text!=CHAR_NEWLINE);
  1935.           break;
  1936.         }
  1937.     scr->virprg=Strtol(scr->text, 10, &scr->text); /* get number */
  1938.     Eat(scr); /* get whitespace */
  1939.     if(*scr->text==CHAR_QUOTATION_MARK) {
  1940.       /* we have a new virtual file name! */
  1941.       scr->virfile=scr->text++; /* just point to this text! */
  1942.       CALL(GetEnd(scr, CHAR_QUOTATION_MARK, 255, FALSE));
  1943.       Eat(scr);
  1944.     }
  1945.       } else
  1946.     return(FPL_OK);
  1947.       break;
  1948.     case CHAR_DIVIDE:
  1949.       if(scr->text[1]==CHAR_MULTIPLY) {
  1950.     CALL(Eatcomment(scr));
  1951.       } else if(scr->text[1]==CHAR_DIVIDE)
  1952.     while (*++scr->text && *scr->text!=CHAR_NEWLINE);
  1953.       else
  1954.     return(FPL_OK);
  1955.       break;
  1956.     default:
  1957.       if(!WSPACE(*scr->text))
  1958.     return(FPL_OK);
  1959.       scr->text++;
  1960.       break;
  1961.     }
  1962.   }
  1963. }
  1964.  
  1965. /*********************************************************************
  1966.  *
  1967.  * Newline()
  1968.  *
  1969.  * This routine gets called everytime the interpreter finds an ASCII
  1970.  * zero in the program. This is made like this for future version which
  1971.  * will be able to specify programs in several ways. (Not only the
  1972.  * array and continues memory alternatives!)
  1973.  *
  1974.  *****/
  1975.  
  1976. ReturnCode Newline(struct Data *scr)
  1977. {
  1978.   if(scr->prg<scr->prog->lines) {
  1979.     scr->text=(&scr->prog->program)[scr->prg++];
  1980.     return(FPL_OK);
  1981.   } else
  1982.     return(FPLERR_UNEXPECTED_END);
  1983. }
  1984.  
  1985. /**********************************************************************
  1986.  *
  1987.  * char CheckIt()
  1988.  *
  1989.  * Returns wether we should return from this Script().
  1990.  *
  1991.  *****/
  1992.  
  1993. static char REGARGS
  1994. CheckIt(struct Data *scr, /* major script structure */
  1995.         struct Expr *val, /* result structure */
  1996.         short control,    /* control defines */
  1997.         ReturnCode *ret)  /* return code pointer */
  1998. {
  1999.   if(val->flags&FPL_BREAK) {
  2000.     /*
  2001.      * A `break' was hit inside that Script() invoke. 
  2002.      */
  2003.     if(control&SCR_LOOP) {
  2004.       if(control&SCR_BRACE) {
  2005.     /*
  2006.          * If we're inside braces, search for the close brace!
  2007.          */
  2008.     if(*ret=GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
  2009.       return((char)*ret);
  2010.       }
  2011.       if(control&SCR_DO) {
  2012.         /*
  2013.          * We're inside a do-statement! We must pass the ending "while"
  2014.          * before returning! We do it the easy way: look for the closing
  2015.          * parenthesis!
  2016.          */
  2017.     if(*ret=GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE))
  2018.       return((char)*ret);
  2019.         else if(*ret = Eat(scr))
  2020.       return((char)*ret);
  2021.         else if(scr->text[0] != CHAR_SEMICOLON) {
  2022.           if(*ret = Warn(scr, FPLERR_MISSING_SEMICOLON))
  2023.             return((char)*ret);
  2024.         } else
  2025.           scr->text++; /* pass the semicolon */
  2026.       }
  2027.       if(--val->val.val<1)
  2028.     val->flags&=~FPL_BREAK; /* clear the break bit! */
  2029.       return(TRUE);
  2030.     } else if(!(control&SCR_FUNCTION))
  2031.       return(TRUE);
  2032.     else if(val->val.val<2) {
  2033.       val->flags&=~FPL_BREAK; /* clear the break bit! */
  2034.       return(FALSE); /* no more break! */
  2035.     }
  2036.     *ret=FPLERR_ILLEGAL_BREAK;
  2037.     return(TRUE);
  2038.   } else if(val->flags&FPL_RETURN)
  2039.     /* The FPL function did end in a return() */
  2040.     return(TRUE);
  2041.   else if(val->flags&FPL_CONTINUE) {
  2042.     if(control&SCR_LOOP) {
  2043.       if(control&SCR_BRACE) {
  2044.     /* If we're inside braces, search for the close brace */
  2045.     if(*ret=GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
  2046.       return((char)*ret);
  2047.     scr->text--; /* move one step back to stand on the close brace */
  2048.     return(FALSE);
  2049.       }
  2050.     } else
  2051.       /* this is not a looping block, break out of it! */
  2052.       return(TRUE);
  2053.   }
  2054.   return(FALSE);
  2055. }
  2056.  
  2057. /**********************************************************************
  2058.  *
  2059.  * CleanUp()
  2060.  *
  2061.  * Deletes/frees all local variable information.
  2062.  *
  2063.  *******/
  2064.  
  2065. void
  2066. CleanUp(struct Data *scr,
  2067.         long control,
  2068.         long levels)
  2069. {
  2070.   if(control&(SCR_BRACE|SCR_FUNCTION)) {
  2071.     DelLocalVar(scr, &scr->locals);
  2072.     scr->varlevel--;
  2073.     scr->level=levels; /* new variable amplitude */
  2074.   }
  2075. }
  2076.  
  2077.  
  2078. /**********************************************************************
  2079.  *
  2080.  * Loop()
  2081.  *
  2082.  * This function is called at the end of a block, however the block was
  2083.  * started (brace or not brace).
  2084.  *
  2085.  *******/
  2086.  
  2087. static ReturnCode REGARGS
  2088. Loop(struct Data *scr,
  2089.      struct Condition *con,
  2090.      short control,
  2091.      char *cont) /* store TRUE or FALSE if loop or not */
  2092. {
  2093.   ReturnCode ret = FPL_OK;
  2094.   char *temptext=scr->text; /* store current position */
  2095.   long temprg=scr->prg;
  2096.   struct Expr val;
  2097.  
  2098.   /*
  2099.    * First check if the block just parsed begun with a while() or for()
  2100.    * or perhaps a do in which we know the statment position!
  2101.    */
  2102.       
  2103.   if((control&SCR_WHILE ||
  2104.       control&SCR_FOR ||
  2105.       (control&SCR_DO && con->check)) &&
  2106.       !scr->compiling) { /* not when compiling! */
  2107.     if(control&SCR_FOR) {     /* check if the pre keyword was for() */
  2108.       scr->text=con->postexpr;/* perform the post expression */
  2109.       scr->prg=con->postexprl;
  2110.       CALL(Expression(&val, scr, CON_GROUNDLVL|CON_PAREN, NULL));
  2111.     }
  2112.     /*
  2113.      * Do the condition check. The only statement if it was a while() or
  2114.      * do while or the second statement if it was a for().
  2115.      *
  2116.      * If it was a for() as pre statement, the statement could contain
  2117.      * nothing but a semicolon and then equals TRUE.
  2118.      */
  2119.     scr->text=con->check;
  2120.     scr->prg=con->checkl;
  2121.     CALL(Expression(&val, scr, CON_GROUNDLVL|
  2122.             (control&SCR_FOR?CON_SEMICOLON:0)|CON_NUM, NULL));
  2123.     
  2124.     if(val.val.val) { /* the result of the condition was true */
  2125.       scr->text=con->bracetext; /* return to the open brace */
  2126.       scr->prg=con->braceprg;
  2127.       *cont=TRUE;
  2128.       return(FPL_OK);
  2129.     }
  2130.   }
  2131.  
  2132.   if(control&SCR_DO) {
  2133.     /* This a do while end. */
  2134.     
  2135.     if(!con->check) {
  2136.       /*
  2137.        * We *DON'T* know the condition position. We have to scan forward
  2138.        * to get it!
  2139.        */
  2140.       if(*scr->text==CHAR_CLOSE_BRACE)
  2141.     /* pass the close brace */
  2142.     scr->text++;
  2143.       if(ret=Getword(scr->buf, scr))
  2144.     ;
  2145.       else if(strcmp(scr->buf, "while"))
  2146.     ret=FPLERR_MISSING_WHILE; /* missing 'while' after do-while statement */
  2147.       else if(ret=Eat(scr))
  2148.     ;
  2149.       else if(*scr->text++!=CHAR_OPEN_PAREN) 
  2150.     ret=FPLERR_MISSING_PARENTHESES; /* >warning< */
  2151.       else {
  2152.     con->check=scr->text;
  2153.     con->checkl=scr->prg;
  2154.         if(scr->compiling)
  2155.           COMPILE(COMP_START_OF_EXPR);
  2156.     if(ret=Expression(&val, scr, CON_GROUNDLVL|CON_NUM, NULL))
  2157.       ;
  2158.     else if(*scr->text++!=CHAR_CLOSE_PAREN)
  2159.       ret=FPLERR_MISSING_PARENTHESES; /* >warning< */
  2160.         else if(scr->compiling)
  2161.           return(FPL_OK);
  2162.       }
  2163.       if(ret)
  2164.     return(ret);
  2165.     }
  2166.     if(!val.val.val || scr->compiling) {
  2167.       /*
  2168.        * If we had the check point up there and the condition equaled
  2169.        * FALSE. Now we have to pass the the while keyword following the
  2170.        * close brace. 
  2171.        */
  2172.       scr->text=temptext;
  2173.       scr->prg=temprg;
  2174.       
  2175.       if(*scr->text==CHAR_CLOSE_BRACE)
  2176.     /* pass the close brace */
  2177.     scr->text++;
  2178.       
  2179.       if(Getword(scr->buf, scr) || strcmp("while", scr->buf))
  2180.     ret=FPLERR_MISSING_WHILE; /* missing 'while' after do-while statement */
  2181.       else if(ret=GetEnd(scr, CHAR_SEMICOLON, (char)255, FALSE))
  2182.     ;
  2183.       if(ret)
  2184.     return(ret);
  2185.     } else {
  2186.       /* go to the open brace */
  2187.       scr->text=con->bracetext;
  2188.       scr->prg=con->braceprg;
  2189.       *cont=TRUE;
  2190.       return(FPL_OK);
  2191.     }
  2192.   }
  2193.   
  2194.   /*
  2195.    * The condition check has failed!
  2196.    */
  2197.  
  2198.   *cont=FALSE;
  2199.   
  2200.   if(!(control&SCR_DO)) {
  2201.     /* it's not a do-while loop */
  2202.     
  2203.     scr->text=temptext;
  2204.     scr->prg=temprg;
  2205.     
  2206.     Eat(scr);
  2207.  
  2208.     if(control&SCR_BRACE && *scr->text==CHAR_CLOSE_BRACE)
  2209.       /* pass the close brace */
  2210.       scr->text++;
  2211.   }
  2212.   
  2213.   return(ret);
  2214. }
  2215.  
  2216. /**********************************************************************
  2217.  *
  2218.  * ReturnCode SkipStatement();
  2219.  *
  2220.  *  This function should pass one statement. Statements starting with
  2221.  * "for", "do", "while" or "if" really can be meesy and in such cases
  2222.  * this function recurse extensively!!!
  2223.  *
  2224.  ******/
  2225.  
  2226. static ReturnCode REGARGS
  2227. SkipStatement(struct Data *scr)
  2228. {
  2229.   ReturnCode ret;
  2230.   struct Identifier *ident;
  2231.   CALL(Eat(scr));
  2232.  
  2233.   if(scr->compiling)
  2234.     COMPILE(COMP_ERROR);
  2235.  
  2236.   if(*scr->text==CHAR_SEMICOLON)
  2237.     scr->text++;
  2238.   else if(*scr->text==CHAR_OPEN_BRACE) {
  2239.     CALL(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE));
  2240.   } else {
  2241.     /*
  2242.      * Much more trouble this way:
  2243.      */
  2244.  
  2245.     char *t;
  2246.     long p;
  2247.  
  2248.     ret = Getword(scr->buf, scr);
  2249.     if(!ret) {
  2250.       GetIdentifier(scr, scr->buf, &ident);
  2251.       switch(ident?ident->data.external.ID:0) {
  2252.       case CMD_IF:
  2253.       case CMD_WHILE:
  2254.         Eat(scr);
  2255.         CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  2256.         CALL(SkipStatement(scr));
  2257.     
  2258.         t=scr->text;
  2259.         p=scr->prg;
  2260.     
  2261.         Getword(scr->buf, scr);
  2262.     
  2263.         if(!strcmp("else", scr->buf)) {
  2264.           CALL(SkipStatement(scr));
  2265.         } else {
  2266.           /*
  2267.            * Restore pointers.
  2268.            */
  2269.           scr->text=t;
  2270.           scr->prg=p;
  2271.         }
  2272.         break;
  2273.       case CMD_FOR:
  2274.         Eat(scr);
  2275.         /* Now we must stand on an open parenthesis */
  2276.         CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  2277.         CALL(SkipStatement(scr));
  2278.         break;
  2279.       case CMD_DO:
  2280.         Eat(scr);
  2281.         CALL(SkipStatement(scr));
  2282.  
  2283.         /*
  2284.          * The next semicolon must be the one after the
  2285.          * following `while' keyword!
  2286.          */
  2287.         CALL(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE));
  2288.         break;
  2289.       default:
  2290.         ret=TRUE;
  2291.       }
  2292.     }
  2293.     if(ret) {
  2294.       /*
  2295.        * This statement ends at the next semicolon
  2296.        */
  2297.       CALL(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE));
  2298.     }
  2299.   }
  2300.   return(FPL_OK);
  2301. }
  2302.  
  2303. #ifdef UNIX
  2304. long InterfaceCall(struct Data *scr,
  2305.            void *arg,
  2306.            long (*func)(void *))
  2307. {
  2308.   return func(arg);
  2309. }
  2310. #endif
  2311.